home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / pbc_bas.exe / SETLABEL.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-01-01  |  1.4 KB  |  41 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE FUNCTION GetDrive$ ()
  8.    DECLARE SUB GetSub1 (Drive$, SubDir$, SubDirLen%, ErrCode%)
  9.    DECLARE SUB SetSub (Subdir$, ErrCode%)
  10.  
  11.    DECLARE SUB SetLabel00 (Drive$, Label$, ErrCode%)
  12.    DECLARE SUB SetLabel01 (Drive$, ErrCode%)
  13.  
  14. SUB SetLabel (Drive$, Label$, ErrCode%)
  15.    IF INSTR(Label$, "?") OR INSTR(Label$, "*") THEN
  16.       ErrCode% = -1
  17.    ELSE
  18.       IF LEN(Drive$) THEN
  19.          D$ = Drive$
  20.       ELSE
  21.          D$ = GetDrive$
  22.       END IF
  23.       CurSub$ = SPACE$(80)
  24.       GetSub1 D$, CurSub$, CurSubLen%, ErrCode%
  25.       IF ErrCode% = 0 THEN
  26.          CurSub$ = LEFT$(CurSub$, CurSubLen%)
  27.          SetSub D$ + ":\", ErrCode%
  28.          IF ErrCode% = 0 THEN
  29.             IF LEN(Label$) THEN
  30.                Lab$ = LEFT$(Label$ + SPACE$(11), 11)
  31.                SetLabel00 D$, Lab$, ErrCode%
  32.             ELSE
  33.                SetLabel01 D$, ErrCode%
  34.             END IF
  35.             SetSub D$ + ":" + CurSub$, ErrC%
  36.             ErrCode% = ErrCode% OR ErrC%
  37.          END IF
  38.       END IF
  39.    END IF
  40. END SUB
  41.